home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1996 #15 / Monster Media Number 15 (Monster Media)(July 1996).ISO / os2 / lxlt113.zip / SOURCES / NOEA.PAS < prev    next >
Pascal/Delphi Source File  |  1996-05-07  |  8KB  |  275 lines
  1. uses  os2base, miscUtil, Helpers, strOp, Crt, Dos;
  2. const Version   = '1.0.1';
  3.       Recurse   : boolean = _OFF;
  4.       Pause     : boolean = _OFF;
  5.       Verbose   : boolean = _OFF;
  6.       AssumeYes : boolean = _OFF;
  7.  
  8.       cmBreak   = 0;
  9.       cmLower   = 1;
  10.       cmUpper   = 2;
  11.       cmMixed   = 3;
  12.       cmAsIs    = 4;
  13.  
  14. var   OldExit   : Procedure;
  15.       fNames    : pDarray;
  16.       allDone   : boolean;
  17.       EA        : pDarray;
  18.  
  19. Procedure Stop(eCode : Byte);
  20. begin
  21.  case eCode of
  22.   1,2 : begin
  23.          if eCode = 2
  24.           then begin
  25.                 TextAttr := $0C;
  26.                 Writeln('├ Invalid switch - see help below for details');
  27.                end;
  28.          TextAttr := $07;
  29.          Writeln('├ Usage: noEA [FileMask1] {...FileMask2} {/EPVYH?}');
  30.          Writeln('├ /E{+|-} r[E]cursive (+) file search through subdirectories');
  31.          Writeln('├ /P{+|-} Enable (+) or disable (-) pause before each file');
  32.          Writeln('├ /V{+|-} Verbose (show EAs instead of removing them)');
  33.          Writeln('├ /Y{+|-} assume (+) on all queries first available responce');
  34.          Writeln('├ /?,/H   Show this help screen');
  35.          Writeln('├┤Default: /E- /P- /V- /Y-');
  36.          TextAttr := $08;
  37.          Writeln('└┤Example: noEA * /e /v');
  38.         end;
  39.  end;
  40.  Halt(eCode);
  41. end;
  42.  
  43. Function ParmHandler(var S : string) : Byte;
  44. var I : Longint;
  45.  
  46. Function Enabled : boolean;
  47. begin
  48.  Enabled := _ON;
  49.  if length(S) = 1
  50.   then exit
  51.   else
  52.  if (S[2] in ['+','-'])
  53.   then ParmHandler := 2
  54.   else
  55.  if (S[2] in [' ','/'])
  56.   then exit
  57.   else Stop(2);
  58.  if S[2] = '-' then Enabled := _OFF;
  59. end;
  60.  
  61. begin
  62.  ParmHandler := 1;
  63.  case upCase(S[1]) of
  64.   '?',
  65.   'H' : Stop(1);
  66.   'E' : Recurse := Enabled;
  67.   'P' : Pause := Enabled;
  68.   'V' : Verbose := Enabled;
  69.   'Y' : AssumeYes := Enabled;
  70.   else Stop(2);
  71.  end;
  72. end;
  73.  
  74. Function NameHandler(var S : string) : Byte;
  75. var I     : Longint;
  76.     Quote : boolean;
  77. begin
  78.  I := 0;
  79.  if S[1] = '"' then begin Quote := _ON; Delete(S, 1, 1); end else Quote := _OFF;
  80.  While (I < length(S)) and ((S[succ(I)] > ' ') or Quote) do
  81.   if Quote and (S[succ(I)] = '"')
  82.    then break
  83.    else Inc(I);
  84.  fNames^.AddItem(NewStr(Copy(S, 1, I)));
  85.  Inc(I, byte(Quote));
  86.  NameHandler := I;
  87. end;
  88.  
  89. Procedure MyExitProc;
  90. begin
  91.  Write(#13);
  92.  TextAttr := $07; ClrEOL;
  93.  OldExit;
  94. end;
  95.  
  96. Function Ask(const Q,A : string) : byte;
  97. var ch  : char;
  98. begin
  99.  if AssumeYes then begin Ask := 1; exit; end;
  100.  TextAttr := $02;
  101.  Write('└ ', Q, ' ');
  102.  repeat
  103.   ch := upCase(ReadKey);
  104.   if First(ch, A) <> 0
  105.    then begin
  106.          Ask := First(ch, A);
  107.          break;
  108.         end;
  109.  until _OFF;
  110.  Writeln(Ch,#13'├');
  111. end;
  112.  
  113. {Returns: 0 - file is not locked for write}
  114. {         1 - file is locked and cannot be unlocked}
  115. {         2 - file has been unlocked}
  116. Function CheckUseCount(fName : string) : byte;
  117. var F : File;
  118.     I : Longint;
  119. begin
  120.  CheckUseCount := 0;
  121.  I := FileMode; FileMode := open_access_ReadWrite or open_share_DenyReadWrite;
  122.  Assign(F, fName); SetFattr(F, Archive);
  123.  Reset(F, 1); Close(F); FileMode := I;
  124.  if ioResult = 0 then exit;
  125.  textAttr := $0E;
  126.  Writeln(#13'├ The module ' + Copy(fName, 1, 40) + ' is used by another process');
  127.  CheckUseCount := 1;
  128.  case Ask('[R]eplace, [S]kip or [A]bort?', 'RSA') of
  129.   1 : ;
  130.   2 : exit;
  131.   3 : begin allDone := _ON; exit; end;
  132.  end;
  133.  fName := fName + #0;
  134.  if DosReplaceModule(@fName[1], nil, nil) <> 0
  135.   then begin
  136.         textAttr := $0C;
  137.         Writeln('├ Cannot replace module ' + fName);
  138.         exit;
  139.        end;
  140.  CheckUseCount := 2;
  141. end;
  142.  
  143. Procedure ShowEAs;
  144. var I : Longint;
  145.     S : String;
  146. begin
  147.  textAttr := $0E; Write(' EA list:');
  148.  textAttr := $0B; Write(#13'├');
  149.  For I := 1 to EA^.numItems do
  150.   with pFea2(EA^.GetItem(I))^ do
  151.    begin
  152.     Move(szName, S[1], cbName);
  153.     S[0] := char(cbName); if length(S) > 60 then S[0] := #60;
  154.     textAttr := $0B; Write(#13#10'├ ');
  155.     textAttr := $02; Write(S, ' (');
  156.     textAttr := $0F; Write(cbValue, ' bytes');
  157.     textAttr := $02; Write(')');
  158.    end
  159. end;
  160.  
  161. Procedure ProcessFile(fName : string; Attr : Word);
  162. var   _d    : DirStr;
  163.       _n    : NameStr;
  164.       _e    : ExtStr;
  165.       I     : Longint;
  166.       P     : pFea2;
  167.  
  168. Procedure TrackProcess;
  169. begin
  170.  textAttr := $0B; ClrEOL; Write('└ Processing ', Copy(_n, 1, 32), ' ...');
  171. end;
  172.  
  173. begin
  174.  EA^.Clear;
  175.  fSplit(fName, _d, _n, _e);
  176.  _n := _n + _e;
  177.  TrackProcess;
  178.  if ReadEAs(fName, EA)
  179.   then begin
  180.         if EA^.numItems = 0
  181.          then begin textAttr := $03; Write(' no EAs'); end
  182.          else if Verbose
  183.                then ShowEAs
  184.                else begin
  185.                      For I := 1 to EA^.numItems do
  186.                       with pFea2(EA^.GetItem(I))^ do
  187.                        begin
  188.                         GetMem(P, sizeOf(Fea2) + cbName);
  189.                         Move(oNextEntryOffset, P^, sizeOf(Fea2) + cbName);
  190.                         FreeMem(EA^.RplItem(I, P), sizeOf(Fea2) + cbName + cbValue);
  191.                         P^.cbValue := 0;
  192.                        end;
  193.                      if Attr and Directory = 0
  194.                       then case CheckUseCount(fName) of
  195.                             1 : Exit;
  196.                             2 : TrackProcess;
  197.                            end;
  198.                      if WriteEAs(fName, EA)
  199.                       then begin textAttr := $0A; Write(' ok'); end
  200.                       else begin textAttr := $0C; Write(' sharing violation'); end;
  201.                     end;
  202.         textAttr := $0B; Writeln(#13'├');
  203.        end
  204.   else begin
  205.         textAttr := $0C; Write(' error');
  206.         textAttr := $0B; Writeln(#13'├');
  207.        end;
  208. end;
  209.  
  210. Procedure ProcessFiles(const fN : string; Level : Longint);
  211. var sr : SearchRec;
  212.     _d : DirStr;
  213.     _n : NameStr;
  214.     _e : ExtStr;
  215.     nf : Longint;
  216. begin
  217.  fSplit(fN, _d, _n, _e);
  218.  FindFirst(fN, Archive or Hidden or SysFile or Directory, sr);
  219.  if (DosError <> 0) and (Level = 0) and (not Recurse)
  220.   then begin
  221.         textAttr := $0C;
  222.         Writeln('├ Cannot find such files: ', fN);
  223.        end;
  224.  nf := 0;
  225.  While (DosError = 0) and (not allDone) do
  226.   begin
  227.    if (sr.Name <> '.') and (sr.Name <> '..')
  228.     then begin
  229.           if Pause
  230.            then case Ask('File ' + sr.Name + ': [P]rocess, [S]kip or [A]bort?', 'PSA') of
  231.                  2 : sr.Name := '';
  232.                  3 : begin allDone := _ON; break; end;
  233.                 end;
  234.           if (sr.Name <> '') then ProcessFile(_d + sr.Name, sr.Attr);
  235.          end;
  236.    FindNext(sr);
  237.   end;
  238.  FindClose(sr);
  239.  if allDone or not Recurse then Exit;
  240.  if nf = 0 then begin textAttr := $0B; Write('└ ', _d); ClrEOL; Write(#13); end;
  241.  FindFirst(_d + '*.*', Archive or Hidden or SysFile or Directory, sr);
  242.  While (dosError = 0) and (not allDone) do
  243.   begin
  244.    if (sr.Attr and Directory <> 0) and (sr.Name[1] <> '.')
  245.     then ProcessFiles(_d + sr.Name + '\' + _n + _e, succ(Level));
  246.    FindNext(sr);
  247.   end;
  248.  FindClose(sr);
  249. end;
  250.  
  251. var I  : Longint;
  252.  
  253. begin
  254.  TextAttr := $0F;
  255.  Writeln('┌[ noEA ]────────────────────────────────[ Version '+Version+' ]┐');
  256.  Writeln('├ Copyright 1996 by FRIENDS software ─ No rights reserved ┘');
  257.  TextAttr := $07;
  258.  @OldExit := ExitProc; ExitProc := @MyExitProc;
  259.  New(fNames, Init(8));
  260.  ParseCommandLine(#1, ParmHandler, NameHandler);
  261.  if (fNames^.numItems = 0) then Stop(1);
  262.  
  263.  New(EA, Init(8));
  264.  For I := 1 to fNames^.numItems do
  265.   begin
  266.    ProcessFiles(pString(fNames^.GetItem(I))^, 0);
  267.    if allDone then break;
  268.   end;
  269.  Dispose(EA, Done);
  270.  
  271.  TextAttr := $01; ClrEOL;
  272.  Writeln('└┤Done');
  273. end.
  274.  
  275.